Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Developer Essentials/DTS Sample Code/System 7.0 Samples/ProcDoggie 1.0a6⁄THINK P/ProcDoggie.p

Text File | 1991-02-21 | 18.3 KB | 573 lines | [TEXT/PJMM]

program ProcDoggie;

{-------------------------------------------------------------------------------}
{#}
{#    Apple Macintosh Developer Technical Support}
{#}
{#    Main program file for the ProcDoggie application}
{#}
{#    Program:    ProcDoggie}
{#    File:        ProcDoggie.p - Pascal Implementation}
{#}
{#    by:        Forrest Tanaka}
{#}
{#    Copyright © 1988-1991 Apple Computer, Inc.}
{#    All rights reserved.}
{#}
{--------------------------------------------------------------------------------}
{#}
{#    ProcDoggie.p is the root file for ProcDoggie.  It contains the main entry}
{#    point and the PROGRAM statement, but relies on the other source files}
{#    included with this application to actually implement the functionality.}
{#}
{-------------------------------------------------------------------------------}
{[j=20/57/1$] Pasmat Options}
{$R-}

{-------------------------------------------------------------------------------}
{#}
{#     2/21/91 pvh - THINK Pascal conversion.}
{#    Notes:}
{#        'uses' modified heavily in each unit to handle toolbox references.}
{#}
{-------------------------------------------------------------------------------}

{$IFC THINK_PASCAL }
{$I- turn off auto init stuff }
{$ENDC}

(*******************************************************************************}
{* Used Units}
{*******************************************************************************)

    uses
        (* Group 1 *)
        Types, QuickDraw,

        (* Group 2 *)
        AppleTalk, PPCToolBox, OSUtils, Files, Processes, EPPC, Notification, AppleEvents, Controls, DiskInit, Errors, Events, Fonts, Memory, Menus, SegLoad,

        (* Group 3 *)
        Windows,

        (* Group 4 *)
        Dialogs,

        (* Application *)
        UGlobals, UEmergMem, UProcessUtils, {UMenuHandler, }
        UProcessGuts;


(*******************************************************************************}
{* Constants}
{*******************************************************************************)

    const
        kBecomingActive = TRUE; {Pass to DoActivateEvt; indicates becoming active}


(*******************************************************************************}
{* Global Variables}
{*******************************************************************************)

    var
        gProcessListWind: WindowPtr; {Pointer to the process list window}


{$S Main}
(*******************************************************************************}
{* DoneRequiredParams - Done processing required params; OK?}
{*}
{* DoneRequiredParams checks to see if the AppleEvent specified by the}
{* anAppleEvent parameter has any required parameters that we haven’t yet}
{* processed.  If there aren’t any left, then noErr is returned.  If there are}
{* required parameters that haven’t been processed yet, then errAEEventNotHandled}
{* is returned.  If any other errors occur, then that error code is returned.}
{*******************************************************************************)

    function DoneRequiredParams (anAppleEvent: AppleEvent): OSErr;

        var
            typeCode: DescType; {Type of AppleEvent attribute found; ignored}
            actualSize: Size;     {Actual size of parameters; ignored}
            error: OSErr;

    begin
        (* Are there any required parameters in AppleEvent we didn’t process? *)
        error := AEGetAttributePtr(anAppleEvent, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize); (*<*)
 (*<*)
        if error = errAEDescNotFound then
            (* No required parameters left, so no error *)
            DoneRequiredParams := noErr
        else if error = noErr then
            (* There was at least one required parameter we didn’t process *)
            DoneRequiredParams := errAEEventNotHandled
        else
            (* Some other error happened *)
            DoneRequiredParams := error
    end;


{$S Main}
(*******************************************************************************}
{* HandleAEquit - Handler for 'quit' AppleEvent}
{*}
{* This is the AppleEvent handler for the 'quit' AppleEvent as passed in the}
{* quitAppleEvent parameter by the AppleEvent Manager.  The DoQuit routine is}
{* called which causes this application to quit at the start of the next}
{* iteration of the main event loop.}
{*}
{* Though the quit AppleEvent doesn’t contain any parameters, the standard thing}
{* to do in reaction to any AppleEvent is to check to see if there are any}
{* required parameters in the AppleEvent that this routine doesn’t recognise.}
{* DoneRequiredParms checks for this condition and returns an error if there are}
{* in fact required parameters in the AppleEvent or if some other error occurs}
{* during the check.}
{*******************************************************************************)

    function HandleAEquit (quitAppleEvent: AppleEvent; reply: AppleEvent; handlerRefCon: LongInt): OSErr;

        var
            error: OSErr;

        procedure RecoverError (errorCode: OSErr);

        begin
            HandleAEquit := errorCode;
            EXIT(HandleAEquit)
        end;

    begin
        (* quit AE has no parms, but check in case the client requires any *)
        error := DoneRequiredParams(quitAppleEvent);
        if error <> noErr then
            RecoverError(error);

        (* Handle the Quit command *)
        DoQuit;
        HandleAEquit := noErr
    end;


{$S %A5Init}
(*******************************************************************************}
{* StartUp - Do whatever has to be done to initialize the application}
{*}
{* This routine is called after the heap is initialized to initialize the}
{* application.  This involves initializing the toolbox, emergency memory, and}
{* loading up the menus.  If any errors occur while doing this, StartUp displays}
{* an alert telling the user what the error was and then ExitToShell is called.}
{* This is an unusual way to react to errors, and I only do it here because it’s}
{* so early in execution that there really isn’t much else that can be done.}
{*}
{* See this UEmergMem unit in this application for details about emergency}
{* memory.}
{*******************************************************************************)

    procedure StartUp;

        const
            kSysHandler = TRUE; {Specifies that AE handler is in system heap}

        var
            error: OSErr;

        procedure HandleError (messageClass: Integer; messageIndex: Integer);

            var
                result: Integer; {Result of alert; ignored}

        begin
            result := ShowStopAlert(messageClass, messageIndex);
            ExitToShell
        end;

    begin
        (* Initialize the toolbox *)
        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil);

        (* Initialize emergency memory *)
        InitEmergMem;
        if FailLowMemory(0) then
            HandleError(rMemErrMessages, kMemErrAppOpenMsg);

        (* Load the menus and draw the menu bar *)
        StartMenus;
        if FailLowMemory(0) then
            HandleError(rMemErrMessages, kMemErrAppOpenMsg)
        else if gError <> noErr then
            if gError = memFullErr then
                HandleError(rMemErrMessages, kMemErrAppOpenMsg)
            else if gError = resNotFound then
                HandleError(rResErrMessages, kResErrAppDamageMsg)
            else
                HandleError(rMiscErrMessages, kMiscErrUnknownMsg);

        (* Install the AppleEvent handler *)
        error := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @HandleAEquit, 0, not kSysHandler);
        if (error = memFullErr) | FailLowMemory(0) then
            HandleError(rMemErrMessages, kMemErrAppOpenMsg)
        else if error <> noErr then
            HandleError(rMiscErrMessages, kMiscErrUnknownMsg)
    end;


{$S Main}
(*******************************************************************************}
{* Public: DoWindowDrag}
{*}
{* A rectangle that covers all screen can be retrieved from the desktop region’s}
{* rgnBBox.  The desktop region can be retrieved by calling GetGrayRgn.}
{*******************************************************************************)

    procedure DoWindowDrag (anEvent: EventRecord; clickedWindow: WindowPtr);

        var
            dragBounds: Rect; {Window can be dragged over this rectangle}

    begin
        (* GetGrayRgn^^.rgnBBox covers the desktop over all screens *)
        dragBounds := GetGrayRgn^^.rgnBBox;
        DragWindow(clickedWindow, anEvent.where, dragBounds)
    end;


{$S Main}
(*******************************************************************************}
{* Public: DoContentClick}
{*}
{* As new kinds of windows are added to this application, this routine will have}
{* to be able to detect the new kind of window and dispatch to the routine that}
{* handles clicks in that kind of window.}
{*******************************************************************************)

    procedure DoContentClick (anEvent: EventRecord; clickedWindow: WindowPtr);

        var
            currWindow: WindowPtr; {Pointer to the current front window}

    begin
        currWindow := FrontWindow;

        (* Clicked window not in front; activate it *)
        if currWindow <> clickedWindow then
            SelectWindow(clickedWindow)
        else if IsProcessListWindow(clickedWindow) then
            ClickProcessListWindow(clickedWindow, anEvent)
    end;


{$S Main}
(*******************************************************************************}
{* Public: DoUpdateEvt}
{*}
{* As new kinds of windows are added to this application, this routine will have}
{* to be able to detect the new kind of window and dispatch to the routine that}
{* handles update events in that kind of window.}
{*******************************************************************************)

    procedure DoUpdateEvt (anEvent: EventRecord);

        var
            eventWindow: WindowPtr; {Pointer to the window to update}

    begin
        eventWindow := WindowPtr(anEvent.message);

        (* Update the window that needs it *)
        SetPort(eventWindow);
        BeginUpdate(eventWindow);
        if IsProcessListWindow(eventWindow) then
            DrawProcessListWindow(eventWindow)
        else if IsProcessInfoWindow(eventWindow) then
            DrawProcessInfoWindow(eventWindow);
        EndUpdate(eventWindow)
    end;


{$S Main}
(*******************************************************************************}
{* Public: DoActivateEvt}
{*}
{* As new kinds of windows are added to this application, this routine will have}
{* to be able to detect the new kind of window and dispatch to the routine that}
{* handles activate events in that kind of window.}
{*******************************************************************************)

    procedure DoActivateEvt (eventWind: WindowPtr; becomingActive: Boolean);

    begin
        if IsProcessListWindow(eventWind) then
            ActivateProcessListWindow(eventWind, becomingActive);
    end;


{$S Main}
(*******************************************************************************}
{* Public: DoWindowClose}
{*}
{* As new kinds of windows are added to this application, this routine will have}
{* to be able to detect the new kind of window and dispatch to the routine that}
{* handles close requests for that kind of window.}
{*******************************************************************************)

    procedure DoWindowClose (anEvent: EventRecord; eventWind: WindowPtr);

    begin
        if TrackGoAway(eventWind, anEvent.where) then
            if IsProcessInfoWindow(eventWind) then
                CloseProcessInfoWindow(eventWind);
    end;


{$S Main}
(*******************************************************************************}
{* DoMouseDown - Mouse-down event dispatcher}
{*}
{* When a mouseDown event is received in the main event loop, this routine is}
{* called to determine which area on the screens the mouseDown was, and to}
{* dispatch to the appropriate routine to handle mouseDown events in that area.}
{* The mouseDown event is passed in the anEvent parameter.}
{*}
{* See the UMenuHandler unit for routines that handle mouse-down events in the}
{* menu bar, and the UWindowHandler unit for routines that handle mouse-down}
{* events in the windows.}
{*******************************************************************************)

    procedure DoMouseDown (anEvent: EventRecord);

        var
            clickArea: Integer;   {Area of the screen that was clicked}
            eventWind: WindowPtr; {Pointer the clicked window, if any}

    begin
        (* Find clicked area of screen or window *)
        clickArea := FindWindow(anEvent.where, eventWind); (*<*)

        (* Jump to mouseDown-handling routine appropriate for screen area *)
        case clickArea of
            inMenuBar:
                DoMenuChoice(MenuSelect(anEvent.where));
            inContent:
                DoContentClick(anEvent, eventWind);
            inGoAway:
                DoWindowClose(anEvent, eventWind);
            inDrag:
                DoWindowDrag(anEvent, eventWind)
        end
    end;


{$S Main}
(*******************************************************************************}
{* DoKeyDown - Key-down event dispatcher}
{*}
{* When a keyDown or autoKey event is received in the main event loop, this}
{* routine is called to determine whether key is a command-key equivalent for a}
{* menu item or not.  If the command key isn’t down, then the key stroke is}
{* ignored.  Otherwise, MenuKey is called to get the menu ID and item number}
{* of the menu item that corresponds to the command key, if any.  Then}
{* DoMenuChoice is called to dispatch to the appropriate routine for the chosen}
{* menu item.  The keyDown or autoKey event is passed in anEvent.}
{*}
{* See the UMenuHandler unit for routines that handle menu events.}
{*******************************************************************************)

    procedure DoKeyDown (anEvent: EventRecord);

        var
            theKey: Char; {ASCII code of key that was pressed}

    begin
        (* Get the ASCII code of the pressed key *)
        theKey := CHR(BAND(anEvent.message, charCodeMask));

        (* If anEvent was keyDown and command key was down, it’s menu command *)
        if (anEvent.what = keyDown) and (BAND(anEvent.modifiers, cmdKey) <> 0) then
            DoMenuChoice(MenuKey(theKey))
    end;


{$S Main}
(*******************************************************************************}
{* DoDiskEvt - Handle a disk-insert event}
{*}
{* This routine is called whenever this application receives an event indicating}
{* that a disk was inserted.  If the disk can’t be mounted, the message field of}
{* the event reflects the error, and we call DIBadMount to allow the user to}
{* format the disk.}
{*******************************************************************************)

    procedure DoDiskEvt (anEvent: EventRecord);

        const
            kSysAlertLeft = 80; {Left coord of DIBadMount alert in screen coords}
            kSysAlertTop = 80; {Top coord of DIBadMount alert in screen coords}

        var
            cornerPoint: Point; {Top-left corner of DIBadMount alert}
            error: OSErr;

    begin
        if HiWrd(anEvent.message) <> noErr then
            begin
                SetPt(cornerPoint, kSysAlertLeft, kSysAlertTop);(*<*)
                error := DIBadMount(cornerPoint, anEvent.message)
            end
    end;


{$S Main}
(*******************************************************************************}
{* Public: DoOSEvt}
{*}
{* When an OS Event is received, it can be a suspend or resume event.}
{*******************************************************************************)

    procedure DoOSEvt (anEvent: EventRecord);

        var
            eventWindow: WindowPtr; {Pointer to window being activated/deactivated}
            osEvtKind: Byte;      {Kind of OSEvt; mouse-moved or suspend/resume}

    begin
        (* Only care if anEvent is suspend/resume event *)
        osEvtKind := BAND(BSR(anEvent.message, 24), $00FF);
        if osEvtKind = suspendResumeMessage then
            begin
                (* It’s a suspend/resume event; suspend or resume? *)
                eventWindow := FrontWindow;
                if BAND(anEvent.message, 1) <> 0 then
                    begin
                        (* Resume event; set the cursor and activate front window *)
                        InitCursor;
                        if eventWindow <> nil then
                            DoActivateEvt(eventWindow, kBecomingActive);
                        gWereInFront := TRUE
                    end
                else
                    begin
                        (* Suspend event; deactivate the front window *)
                        if eventWindow <> nil then
                            DoActivateEvt(eventWindow, not kBecomingActive);
                        gWereInFront := FALSE
                    end
            end
    end;


{$S Main}
(*******************************************************************************}
{* DoHighLevelEvent - Handle a high-level event}
{*}
{* This routine handles the high-level event specified by anEvent.  The only}
{* high-level events that this application handles are AppleEvents, so I just}
{* pass the high-level event to AEProcessAppleEvent.  AEProcessAppleEvent calls}
{* the appropriate AppleEvent handler routine to handle that particular kind of}
{* AppleEvent.}
{*******************************************************************************)

    function AEProcessAppleEvent2 (theEventRecord: EventRecord): OSErr;
    inline
        $303C, $021B, $A816;

    procedure DoHighLevelEvent (anEvent: EventRecord);

        var
            error: OSErr;
    begin
        error := AEProcessAppleEvent2(anEvent);
    end;


{$S Main}
(*******************************************************************************}
{* EventLoop - Main event loop for this application}
{*}
{* This is the main event loop of this application.  During every iteration of}
{* the event loop, the menus are kept up-to-date, and the Process List window and}
{* all of the open Process Information windows are given time to update}
{* themselves to current conditions.  Also, NoEmergMem is called to detect}
{* whether the emergency memory was used.  If it was, then RecoverEmergMem is}
{* called in an attept to get it back.  If it can’t, then some commands could be}
{* disabled until the memory can be recovered.}
{*******************************************************************************)

    procedure EventLoop;

        var
            anEvent: EventRecord; {An incoming event}

    begin
        FixMenus;
        InitCursor;
        gWereInFront := WereInFront;
        gQuitting := FALSE;

        (* We loop “forever,” or until the Quit handler calls ExitToShell *)
        while not gQuitting do
            begin
                (* Give all open windows some time *)
                IdleAllProcessWindows;

                (* Try to reallocate emergency memory if it’s been used *)
                if NoEmergMem then
                    RecoverEmergMem;

                (* Fix the menus to reflect current conditions *)
                FixMenus;

                (* It’s time to get and examine an event *)
                if WaitNextEvent(everyEvent, anEvent, kMaxSleepTime, nil) then (*<*)
                    begin
                        case anEvent.what of
                            mouseDown:
                                DoMouseDown(anEvent);
                            keyDown, autoKey:
                                DoKeyDown(anEvent);
                            updateEvt:
                                DoUpdateEvt(anEvent);
                            diskEvt:
                                DoDiskEvt(anEvent);
                            activateEvt:
                                DoActivateEvt(WindowPtr(anEvent.message), BAND(anEvent.modifiers, activeFlag) <> 0);
                            osEvt:
                                DoOSEvt(anEvent);
                            kHighLevelEvent:
                                DoHighLevelEvent(anEvent)
                        end
                    end
            end
    end;


begin
    (* Set up the heap *)
    MaxApplZone;
    MoreMasters;
    MoreMasters;
    MoreMasters;
    MoreMasters;
    MoreMasters;
    MoreMasters;

    (* Do anything that must be done at program start-up *)
    StartUp;
{$IFC UNDEFINED THINK_PASCAL}
    UnloadSeg(@StartUp);
{$ENDC}

    (* Set the default launch mode *)
    SetLaunchMode(kJustLaunch);

    (* Open the process list window *)
    gProcessListWind := CreateProcessListWindow;

    (* Enter the main event loop *)
    EventLoop
end.